home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok29.lha / Disky / FileRequest.mod < prev    next >
Text File  |  1993-08-15  |  42KB  |  1,185 lines
  1. (* -------------------------------------------------------------------------
  2.   :Program.       FileRequest
  3.   :Contents.      exportiert Prozedur zum erzeugen eines FileRequesters
  4.   :Author.        Kai Bolay
  5.   :Address.       Hoffmannstraße 168, 7250 Leonberg 1
  6.   :Phone.         07152/22135
  7.   :History.       v1.01 Kai Bolay 28-Jul-89 Added ownFont-Flag
  8.   :History.       v1.02 Kai Bolay 29-Jul-89 Bug fixed in MatchSuffx/CutSuffix
  9.   :History.       v1.10 Carsten Mehring 08-Aug-89 faster SortList (QSort-Algoritm)
  10.   :History.       v1.11 Kai Bolay 17-Sep-89 Bug fixed (File-Gadget & UpdateGad)
  11.   :History.       v1.12 Kai Bolay 08-Oct-89 Dir-Display now fine
  12.   :History.       v1.13 Kai Bolay 22-Oct-89 tried to correct SortList
  13.   :History.       v1.20 Kai Bolay 01-Nov-89 SortList removed / sort in AddEntry
  14.   :History.       v1.30 Kai Bolay 24-Nov-89 dirExt, DoubleKlick, respect select
  15.   :Copyright.     PD
  16.   :Language.      Modula-2
  17.   :Translator.    M2Amiga 3.2d
  18.   :Imports.       IntuiStruct1.3 [bne]
  19. ------------------------------------------------------------------------- *)
  20.  
  21. IMPLEMENTATION MODULE FileRequest;
  22.  
  23. (* FOLD: IMPORT *)
  24. FROM SYSTEM      IMPORT ADR, LONGSET;
  25. FROM Str         IMPORT Compare, Copy, Length, Concat, LastPos, noOccur;
  26. FROM Dos         IMPORT FileInfoBlockPtr, Lock, UnLock, ParentDir,
  27.                         FileLockPtr, accessRead, IoErr, noMoreEntries,
  28.                         Examine, ExNext, DeviceListPtr, DeviceListType,
  29.                         DosLibraryPtr, DupLock, BSTR;
  30. FROM Exec        IMPORT WaitPort, GetMsg, ReplyMsg, Forbid, Permit, UByte;
  31. FROM Graphics    IMPORT SetFont, OpenFont, CloseFont, RastPortPtr, jam1,
  32.                         jam2, TextFontPtr, FontFlags, FontFlagSet, RectFill,
  33.                         SetAPen;
  34. FROM Intuition   IMPORT DisplayBeep, Gadget, GadgetPtr, PropInfo,
  35.                         customScreen, StringInfo, IntuiMessagePtr,
  36.                         IntuiText, Border, WindowPtr, IDCMPFlagSet,
  37.                         IDCMPFlags, ScreenPtr, Image, RefreshGList,
  38.                         RefreshGadgets, NewModifyProp, maxBody, maxPot,
  39.                         PropInfoFlags, PropInfoFlagSet, NewWindow,
  40.                         GadgetFlags, GadgetFlagSet, boolGadget, strGadget,
  41.                         propGadget, ActivationFlags, OpenWorkBench,
  42.                         ActivationFlagSet, WindowFlags, WindowFlagSet,
  43.                         OpenWindow, CloseWindow, ScreenFlags, ScreenFlagSet,
  44.                         DoubleClick;
  45. FROM IntuiStruct IMPORT StructBorder, FreeBorder, StructText, StructWindow,
  46.                         StructGadget, StructProp, StructString, BorderEnd,
  47.                         AddLine, AllocProc, DeallocProc;
  48. FROM Heap        IMPORT Allocate, Deallocate, AllocMem;
  49. IMPORT Strings, Dos;
  50. (* ENDFD *)
  51. (* FOLD: CONST *)
  52. CONST MaxFL = 30;  (* max. Länge der Strings *)
  53.       MaxPL = 150;
  54.       MaxSL = 8;
  55.       MaxDL = 8;
  56.  
  57.       StdGPen  = 1;   (* Farbe der Elemente *)
  58.       StdFPen  = 2;
  59.       StdDPen  = 3;
  60.       StdBFPen = 0;
  61.  
  62.       MinFileID = 1; (* Gadget IDs (allgemein) *)
  63.       MaxFileID = 10;
  64.       PropID    = 11;
  65.       MinPathID = 12;
  66.       MaxPathID = 13;
  67.       MinDevID  = 14;
  68.       MaxDevID  = 22;
  69.       MinStrID  = 23;
  70.       MaxStrID  = 25;
  71.       MinEndID  = 26;
  72.       MaxEndID  = 27;
  73.  
  74.       RootID   = 12; (* Gadget IDs (speziell) *)
  75.       ParentID = 13;
  76.       DirID    = 23;
  77.       FileID   = 24;
  78.       SuffixID = 25;
  79.       OKID     = 26;
  80.       CancelID = 27;
  81. (* ENDFD *)
  82. (* FOLD: TYPE *)
  83. TYPE FileGadStatus  = (file, dir, empty);
  84.      ProgStatus     = (begin, read, ready);
  85.      String         = ARRAY [0..999] OF CHAR;
  86.      StringPtr      = POINTER TO String;
  87.      StringEntryPtr = POINTER TO StringEntry;
  88.      StringEntry    = RECORD
  89.                          nextEntry : StringEntryPtr;
  90.                          string    : StringPtr;
  91.                       END; (* RECORD *)
  92.      StringListPtr  = POINTER TO StringList;
  93.      StringList     = RECORD
  94.                          numEntries : CARDINAL;
  95.                          maxLength  : CARDINAL;
  96.                          firstEntry : StringEntryPtr;
  97.                       END; (* RECORD *)
  98.      GadStuff       = RECORD
  99.                          FileITxt    : ARRAY [1..10] OF IntuiText;
  100.                          FileTxt     : ARRAY [1..10] OF ARRAY [0..MaxFL] OF CHAR;
  101.                          StrITxt     : ARRAY [1..3] OF IntuiText;
  102.                          (* StrTxt is CONST *)
  103.                          DevITxt     : ARRAY [1..9] OF IntuiText;
  104.                          DevTxt      : ARRAY [1..9] OF ARRAY [0..MaxDL] OF CHAR;
  105.                          PathITxt    : ARRAY [1..2] OF IntuiText;
  106.                          (* PathTxt is CONST *)
  107.                          EndITxt     : ARRAY [1..2] OF IntuiText;
  108.                          (* EndTxt is CONST *)
  109.                          NumDevs     : [0..9];
  110.                          File        : ARRAY [1..10] OF Gadget;
  111.                          Prop        : Gadget;
  112.                          Path        : ARRAY [1..2] OF Gadget;
  113.                          Str         : ARRAY [1..3] OF Gadget;
  114.                          Dev         : ARRAY [1..9] OF Gadget;
  115.                          End         : ARRAY [1..2] OF Gadget;
  116.                          StrInfo     : ARRAY [1..3] OF StringInfo;
  117.                          MyPropInfo  : PropInfo;
  118.                          UndoBuffer  : ARRAY [0..300] OF CHAR;
  119.                          KnobImage   : Image;
  120.                          BoolBorder  : Border;
  121.                          StrBorder   : ARRAY [1..2] OF Border;
  122.                          SufBorder   : ARRAY [1..2] OF Border;
  123.                          HyperBorder : Border;
  124.                       END; (* RECORD *)
  125.      GadStuffPtr    = POINTER TO GadStuff;
  126. (* ENDFD *)
  127. (* FOLD: Disky *)
  128. PROCEDURE Disky (VAR DI : DiskyInfo) : DiskyResult;
  129.  
  130. VAR MyFIBPtr       : FileInfoBlockPtr;
  131.     DiskyWindowPtr : WindowPtr;
  132.     DiskyRPortPtr  : RastPortPtr;
  133.     GadgetsPtr     : GadStuffPtr;
  134.     ID             : CARDINAL;
  135.     CurrentLockPtr : FileLockPtr;
  136.     BackupLockPtr  : FileLockPtr;
  137.     DirList        : StringList;
  138.     FileList       : StringList;
  139.     OldTop         : CARDINAL;
  140.     FMode          : ARRAY [1..10] OF FileGadStatus;
  141.     Files          : ARRAY [1..10] OF ARRAY [0..MaxFL] OF CHAR;
  142.     Mode           : ProgStatus;
  143.     FileNum        : [1..10];
  144.     FontPtr        : TextFontPtr;
  145.     lastSec, Sec   : LONGCARD;
  146.     lastMic, Mic   : LONGCARD;
  147.     len            : CARDINAL;
  148.  
  149.    (* FOLD: BSTRCopy *)
  150.    PROCEDURE BSTRCopy (VAR dest : ARRAY OF CHAR; source : BSTR);
  151.  
  152.    BEGIN
  153.       Strings.Copy (dest, source^, 1, INTEGER (source^[0]));
  154.    END BSTRCopy;
  155.    (* ENDFD *)
  156.    (* FOLD: BuildRequester *)
  157.    PROCEDURE BuildRequester() : BOOLEAN;
  158.  
  159.    CONST Parent  = " / ";
  160.          Root    = " : ";
  161.          GOK     = "OK!";
  162.          GCancel = "Abbruch";
  163.          EOK     = "OK!";
  164.          ECancel = "Cancel";
  165.          GDir    = "Ordner";
  166.          GFile   = "Datei";
  167.          GSuf    = "Suffix";
  168.          EDir    = "Directory";
  169.          EFile   = "File";
  170.          ESuf    = "Suffix";
  171.  
  172.  
  173.    VAR Pen, Back      : UByte;
  174.        num            : CARDINAL;
  175.        NextPtr        : GadgetPtr;
  176.        DevLeft        : CARDINAL;
  177.        NewDiskyWindow : NewWindow;
  178.        TheScreenPtr   : ScreenPtr;
  179.  
  180.       (* FOLD: BuildDriveList *)
  181.       PROCEDURE BuildDriveList;
  182.  
  183.       VAR MyDOSBasePtr : DosLibraryPtr;
  184.           MyDevListPtr : DeviceListPtr;
  185.  
  186.       BEGIN
  187.          MyDOSBasePtr := ADR (Dos);
  188.          MyDevListPtr := MyDOSBasePtr^.root^.info^.devInfo;
  189.          Forbid;
  190.          GadgetsPtr^.NumDevs := 0;
  191.          WHILE MyDevListPtr # NIL DO
  192.             IF MyDevListPtr^.type = device THEN
  193.                IF (MyDevListPtr^.task # NIL) THEN
  194.                   WITH GadgetsPtr^ DO
  195.                      IF NumDevs < 9 THEN
  196.                         INC (NumDevs);
  197.                         BSTRCopy (DevTxt[NumDevs], MyDevListPtr^.name);
  198.                         Concat (DevTxt[NumDevs], ":");
  199.                      END; (* IF *)
  200.                   END; (* WITH *)
  201.                END; (* IF *)
  202.             END; (* IF *)
  203.             MyDevListPtr := MyDevListPtr^.next;
  204.          END; (* WHILE *)
  205.          Permit;
  206.       END BuildDriveList;
  207.       (* ENDFD *)
  208.       (* FOLD: CorrectFont *)
  209.       PROCEDURE CorrectFont; (* Does not work !!! *)
  210.  
  211.       VAR num  : [1..3];
  212.           rast : RastPortPtr;
  213.  
  214.       BEGIN
  215.          SetFont (DiskyWindowPtr^.rPort, FontPtr);
  216.          FOR num := 1 TO 3 DO
  217.             WITH GadgetsPtr^.StrInfo[num] DO
  218.                IF layerPtr # NIL THEN
  219.                   WITH layerPtr^ DO
  220.                      IF rp # NIL THEN
  221.                         rast := rp;
  222.                      END; (* IF *)
  223.                   END; (* WITH *)
  224.                END; (* IF *)
  225.             END; (* WITH *)
  226.             IF rast # NIL THEN
  227.                SetFont (rast, FontPtr);
  228.             END; (* IF *)
  229.          END; (* FOR *)
  230.       END CorrectFont;
  231.       (* ENDFD *)
  232.  
  233.    BEGIN
  234.       IF NOT (onlyFiles IN DI.flags) THEN
  235.          BuildDriveList;
  236.       END; (* IF *)
  237.  
  238.       WITH GadgetsPtr^ DO
  239.          IF NOT (ownColors IN DI.flags) THEN
  240.             Pen := StdGPen;
  241.             Back := StdBFPen;
  242.          ELSE
  243.             Pen := DI.gadgetPen;
  244.             Back := DI.backFillPen;
  245.          END; (* IF *)
  246.  
  247.          (* FOLD: Borders *)
  248.          StructBorder (BoolBorder, -2, -1, Pen, jam1, 9, NIL);
  249.          AddLine (87, 00); AddLine (87, 10); AddLine (88, 10);
  250.          AddLine (88, 00); AddLine (88, 10); AddLine (01, 10);
  251.          AddLine (01, 00); AddLine (00, 00); AddLine (00, 10);
  252.          BorderEnd;
  253.          StructBorder (StrBorder[1], -4, -2, Pen, jam1, 9,
  254.                        ADR (StrBorder[2]));
  255.          AddLine (180, 000); AddLine (180, 010); AddLine (181, 010);
  256.          AddLine (181, 000); AddLine (181, 010); AddLine (001, 010);
  257.          AddLine (001, 000); AddLine (000, 000); AddLine (000, 010);
  258.          BorderEnd;
  259.          StructBorder (StrBorder[2], -97, -2, Pen, jam1, 9, NIL);
  260.          AddLine (87, 00); AddLine (87, 10); AddLine (88, 10);
  261.          AddLine (88, 00); AddLine (88, 10); AddLine (01, 10);
  262.          AddLine (01, 00); AddLine (00, 00); AddLine (00, 10);
  263.          BorderEnd;
  264.          StructBorder (SufBorder[1], -4, -2, Pen, jam1, 9,
  265.                        ADR (SufBorder[2]));
  266.          AddLine (87, 00); AddLine (87, 10); AddLine (88, 10);
  267.          AddLine (88, 00); AddLine (88, 10); AddLine (01, 10);
  268.          AddLine (01, 00); AddLine (00, 00); AddLine (00, 10);
  269.          BorderEnd;
  270.          StructBorder (SufBorder[2], -97, -2, Pen, jam1, 9, NIL);
  271.          AddLine (87, 00); AddLine (87, 10); AddLine (88, 10);
  272.          AddLine (88, 00); AddLine (88, 10); AddLine (01, 10);
  273.          AddLine (01, 00); AddLine (00, 00); AddLine (00, 10);
  274.          BorderEnd;
  275.          StructBorder (HyperBorder, -2, -1, Pen, jam1, 9, NIL);
  276.          AddLine (249, 000); AddLine (249, 091); AddLine (250, 091);
  277.          AddLine (250, 000); AddLine (250, 091); AddLine (001, 091);
  278.          AddLine (001, 000); AddLine (000, 000); AddLine (000, 091);
  279.          BorderEnd;
  280.          (* ENDFD *)
  281.          (* FOLD: File-Gadgets *)
  282.          FOR num := 1 TO 10 DO
  283.             StructText (FileITxt[num], Pen, Back, jam2, 2, 1, NIL, NIL);
  284.             IF (ownFont IN DI.flags) THEN
  285.                FileITxt[num].iTextFont := DI.font;
  286.             END; (* IF *)
  287.             IF num # 10 THEN
  288.                NextPtr := ADR (File[num+1]);
  289.             ELSE
  290.                NextPtr := ADR (Prop);
  291.             END; (* IF *)
  292.             StructGadget (File[num], 8, 4+num*9, 247, 9, GadgetFlagSet {},
  293.                           ActivationFlagSet {relVerify}, boolGadget, NIL,
  294.                           ADR (FileITxt[num]), LONGSET {}, num, NextPtr);
  295.             File[1].gadgetRender := ADR (HyperBorder);
  296.          END; (* IF *)
  297.          (* ENDFD *)
  298.          (* FOLD: Prop-Gadget *)
  299.          StructGadget (Prop, 261, 12, 20, 92, GadgetFlagSet {},
  300.                        ActivationFlagSet {followMouse}, propGadget,
  301.                        ADR (KnobImage), NIL, LONGSET {}, 11, ADR (Path[1]));
  302.          StructProp (MyPropInfo, PropInfoFlagSet {freeVert, autoKnob},
  303.                      0, 0, 0, maxBody);
  304.          Prop.specialInfo := ADR (MyPropInfo);
  305.          IF (onlyFiles IN DI.flags) THEN
  306.             Prop.nextGadget := ADR (Str[2]);
  307.          END; (* IF *)
  308.          NewDiskyWindow.height := 107;
  309.          (* ENDFD *)
  310.          (* FOLD: Control-Gadgets ( ':' / '/') *)
  311.          IF NOT (onlyFiles IN DI.flags) THEN
  312.             StructText (PathITxt[1], Pen, 0, jam1, 32, 1, ADR (Root), NIL);
  313.             IF (ownFont IN DI.flags) THEN
  314.                PathITxt[1].iTextFont := DI.font;
  315.             END; (* IF *)
  316.             StructGadget (Path[1], 8, NewDiskyWindow.height, 85, 9,
  317.                           GadgetFlagSet {}, ActivationFlagSet {relVerify},
  318.                           boolGadget, ADR (BoolBorder), ADR (PathITxt[1]),
  319.                           LONGSET {}, 12, ADR (Path[2]));
  320.             StructText (PathITxt[2], Pen, 0, jam1, 32, 1, ADR (Parent), NIL);
  321.             IF (ownFont IN DI.flags) THEN
  322.                PathITxt[2].iTextFont := DI.font;
  323.             END; (* IF *)
  324.             StructGadget (Path[2], 194, NewDiskyWindow.height, 85, 9,
  325.                           GadgetFlagSet {}, ActivationFlagSet {relVerify},
  326.                           boolGadget, ADR (BoolBorder), ADR (PathITxt[2]),
  327.                           LONGSET {}, 13, ADR (Dev[1]));
  328.             INC (NewDiskyWindow.height, 13);
  329.          END; (* IF *)
  330.          (* ENDFD *)
  331.          (* FOLD: Device-Gadgets *)
  332.          IF NOT (onlyFiles IN DI.flags) THEN
  333.             DevLeft := 8;
  334.             FOR num := 1 TO NumDevs DO
  335.                StructText (DevITxt[num], Pen, 0, jam1, 23, 1, ADR (DevTxt[num]),
  336.                            NIL);
  337.                IF (ownFont IN DI.flags) THEN
  338.                   DevITxt[num].iTextFont := DI.font;
  339.                END; (* IF *)
  340.                IF num # NumDevs THEN
  341.                   NextPtr := ADR (Dev[num+1]);
  342.                ELSE
  343.                   NextPtr := ADR (Str[1]);
  344.                END; (* IF *)
  345.                IF (((num - 1) MOD 3) = 0) AND (num # 1) THEN
  346.                   INC (NewDiskyWindow.height, 13);
  347.                END; (* IF *)
  348.                StructGadget (Dev[num], DevLeft, NewDiskyWindow.height, 85, 9,
  349.                              GadgetFlagSet {}, ActivationFlagSet {relVerify},
  350.                              boolGadget, ADR (BoolBorder), ADR (DevITxt[num]),
  351.                              LONGSET {}, num + 13, NextPtr);
  352.                INC (DevLeft, 93);
  353.                IF DevLeft > 194 THEN DevLeft := 8; END;
  354.             END; (* FOR *)
  355.             IF (NumDevs # 0) THEN
  356.                INC (NewDiskyWindow.height, 13);
  357.             ELSE
  358.                Path[2].nextGadget := ADR (Str[1]);
  359.             END; (* IF *)
  360.          END; (* IF *)
  361.          (* ENDFD *)
  362.          (* FOLD: String-Gadgets *)
  363.          IF NOT (onlyFiles IN DI.flags) THEN
  364.             IF (german IN DI.flags) THEN
  365.                StructText (StrITxt[1], Pen, 0, jam1, -88, 0, ADR (GDir), NIL);
  366.             ELSE
  367.                StructText (StrITxt[1], Pen, 0, jam1, -92, 0, ADR (EDir), NIL);
  368.             END; (* IF *)
  369.             IF (ownFont IN DI.flags) THEN
  370.                StrITxt[1].iTextFont := DI.font;
  371.             END; (* IF *)
  372.             StructGadget (Str[1], 103, NewDiskyWindow.height + 1, 180, 9,
  373.                           GadgetFlagSet {}, ActivationFlagSet {relVerify},
  374.                           strGadget, ADR (StrBorder), ADR (StrITxt[1]),
  375.                           LONGSET {}, 23, ADR (Str[2]));
  376.             StructString (StrInfo[1], DI.dir, UndoBuffer);
  377.             StrInfo[1].dispCount := 22; (* Klaedtke *)
  378.             Str[1].specialInfo := ADR (StrInfo[1]);
  379.             INC (NewDiskyWindow.height, 13);
  380.          END; (* IF *)
  381.  
  382.          IF (german IN DI.flags) THEN
  383.             StructText (StrITxt[2], Pen, 0, jam1, -88, 0, ADR (GFile), NIL);
  384.          ELSE
  385.             StructText (StrITxt[2], Pen, 0, jam1, -92, 0, ADR (EFile), NIL);
  386.          END; (* IF *)
  387.          IF (ownFont IN DI.flags) THEN
  388.             StrITxt[2].iTextFont := DI.font;
  389.          END; (* IF *)
  390.          IF NOT (suffixGad IN DI.flags) THEN
  391.             NextPtr := ADR (End[1]);
  392.          ELSE
  393.             NextPtr := ADR (Str[3]);
  394.          END; (* IF *)
  395.          StructGadget (Str[2], 103, NewDiskyWindow.height + 1, 180, 9,
  396.                        GadgetFlagSet {}, ActivationFlagSet {relVerify},
  397.                        strGadget, ADR (StrBorder), ADR (StrITxt[2]),
  398.                        LONGSET {}, 24, NextPtr);
  399.          StructString (StrInfo[2], DI.file, UndoBuffer);
  400.          Str[2].specialInfo := ADR (StrInfo[2]);
  401.          INC (NewDiskyWindow.height, 13);
  402.  
  403.          IF (suffixGad IN DI.flags) THEN
  404.             IF (german IN DI.flags) THEN
  405.                StructText (StrITxt[3], Pen, 0, jam1, -88, 0, ADR (GSuf), NIL);
  406.             ELSE
  407.                StructText (StrITxt[3], Pen, 0, jam1, -92, 0, ADR (ESuf), NIL);
  408.             END; (* IF *)
  409.             IF (ownFont IN DI.flags) THEN
  410.                StrITxt[3].iTextFont := DI.font;
  411.             END; (* IF *)
  412.             StructGadget (Str[3], 103, NewDiskyWindow.height + 1, 85, 9,
  413.                           GadgetFlagSet {}, ActivationFlagSet {relVerify},
  414.                           strGadget, ADR (SufBorder), ADR (StrITxt[3]),
  415.                           LONGSET {}, 25, ADR (End[1]));
  416.             StructString (StrInfo[3], DI.suffix, UndoBuffer);
  417.             Str[3].specialInfo := ADR (StrInfo[3]);
  418.             INC (NewDiskyWindow.height, 13);
  419.          END; (* IF *)
  420.          (* ENDFD *)
  421.          (* FOLD: End-Gadgets (OK / CANCEL) *)
  422.          IF (german IN DI.flags) THEN
  423.             StructText (EndITxt[1], Pen, 0, jam1, 33, 1, ADR (GOK), NIL);
  424.          ELSE
  425.             StructText (EndITxt[1], Pen, 0, jam1, 33, 1, ADR (EOK), NIL);
  426.          END; (* IF *)
  427.          IF (ownFont IN DI.flags) THEN
  428.             EndITxt[1].iTextFont := DI.font;
  429.          END; (* IF *)
  430.          StructGadget (End[1], 8, NewDiskyWindow.height, 85, 9,
  431.                        GadgetFlagSet {}, ActivationFlagSet {relVerify},
  432.                        boolGadget, ADR (BoolBorder), ADR (EndITxt[1]),
  433.                        LONGSET {}, 26, ADR (End[2]));
  434.  
  435.          IF (german IN DI.flags) THEN
  436.             StructText (EndITxt[2], Pen, 0, jam1, 17, 1, ADR (GCancel), NIL);
  437.          ELSE
  438.             StructText (EndITxt[2], Pen, 0, jam1, 21, 1, ADR (ECancel), NIL);
  439.          END; (* IF *)
  440.          IF (ownFont IN DI.flags) THEN
  441.             EndITxt[2].iTextFont := DI.font;
  442.          END; (* IF *)
  443.          StructGadget (End[2], 194, NewDiskyWindow.height, 85, 9,
  444.                        GadgetFlagSet {}, ActivationFlagSet {relVerify},
  445.                        boolGadget, ADR (BoolBorder), ADR (EndITxt[2]),
  446.                        LONGSET {}, 27, NIL);
  447.          INC (NewDiskyWindow.height, 13);
  448.          (* ENDFD *)
  449.       END; (* WITH *)
  450.  
  451.       (* Window öffnen ! *)
  452.  
  453.       WITH NewDiskyWindow DO
  454.          width       := 287;
  455.          detailPen   := Back;
  456.          blockPen    := Pen;
  457.          idcmpFlags  := IDCMPFlagSet {gadgetUp, mouseMove};
  458.          flags       := WindowFlagSet {activate, rmbTrap, windowDrag,
  459.                                        windowDepth};
  460.          title       := DI.title;
  461.          firstGadget := ADR (GadgetsPtr^.File[1]);
  462.          IF (ownScreen IN DI.flags) AND (DI.screen # NIL) THEN
  463.             TheScreenPtr := DI.screen;
  464.             screen := DI.screen;
  465.             type   := customScreen; (* I guess *)
  466.          ELSE
  467.             TheScreenPtr := OpenWorkBench();
  468.             screen := NIL;
  469.             type   := ScreenFlagSet {wbenchScreen};
  470.          END; (* IF *)
  471.          IF NOT (ownPosition IN DI.flags) OR
  472.             (DI.x < 0) OR (DI.x + width > TheScreenPtr^.width) THEN
  473.             leftEdge := (TheScreenPtr^.width - width) / 2;
  474.          ELSE
  475.             leftEdge := DI.x;
  476.          END; (* IF *)
  477.          IF NOT (ownPosition IN DI.flags) OR (DI.y < 0) OR
  478.             (DI.y + height > TheScreenPtr^.height) THEN
  479.             topEdge := (TheScreenPtr^.height - height) / 2;
  480.          ELSE
  481.             topEdge := DI.y;
  482.          END; (* IF *)
  483.       END; (* WITH *)
  484.       DiskyWindowPtr := OpenWindow (NewDiskyWindow);
  485.    (* WITH DiskyWindowPtr^ DO
  486.          SetAPen (rPort, Back);
  487.          RectFill (rPort, 2, 10, width-4, height-2);
  488.          RefreshGadgets (firstGadget, DiskyWindowPtr, NIL);
  489.       END; (* WITH *) *) (* This should be the BackFill-Pen *)
  490.       IF DiskyWindowPtr # NIL THEN
  491.          IF (ownFont IN DI.flags) THEN
  492.             FontPtr := OpenFont (DI.font);
  493.             IF FontPtr = NIL THEN
  494.                RETURN FALSE;
  495.             ELSE
  496.                CorrectFont;
  497.             END; (* IF *)
  498.          END; (* IF *)
  499.          RETURN TRUE;
  500.       ELSE
  501.          RETURN FALSE;
  502.       END; (* IF *)
  503.    END BuildRequester;
  504.    (* ENDFD *)
  505.    (* FOLD: FileExists *)
  506.    PROCEDURE FileExists (File: ARRAY OF CHAR) : BOOLEAN;
  507.  
  508.    VAR TestLockPtr : FileLockPtr;
  509.  
  510.    BEGIN
  511.       TestLockPtr := Lock (ADR (File), accessRead);
  512.       IF TestLockPtr # NIL THEN
  513.          UnLock (TestLockPtr);
  514.          RETURN TRUE;
  515.       ELSE
  516.          RETURN FALSE;
  517.       END; (* IF *)
  518.    END FileExists;
  519.    (* ENDFD *)
  520.    (* FOLD: InitList *)
  521.    PROCEDURE InitList (VAR List : StringList; MaxLength : CARDINAL);
  522.  
  523.    BEGIN
  524.       WITH List DO
  525.          numEntries := 0;
  526.          maxLength  := MaxLength;
  527.          firstEntry := NIL;
  528.       END; (* WITH *)
  529.    END InitList;
  530.    (* ENDFD *)
  531.    (* FOLD: FreeList *)
  532.    PROCEDURE FreeList (VAR List : StringList);
  533.  
  534.    VAR CurrentPtr, NextPtr : StringEntryPtr;
  535.  
  536.    BEGIN
  537.       WITH List DO
  538.          IF NOT ((numEntries = 0) OR (firstEntry = NIL)) THEN
  539.             CurrentPtr := firstEntry;
  540.             WHILE (CurrentPtr # NIL) DO
  541.                NextPtr := CurrentPtr^.nextEntry;
  542.                Deallocate (CurrentPtr^.string);
  543.                Deallocate (CurrentPtr);
  544.                CurrentPtr := NextPtr;
  545.             END; (* WHILE *)
  546.          END; (* IF *)
  547.          InitList (List, maxLength);
  548.       END; (* WITH *)
  549.    END FreeList;
  550.    (* ENDFD *)
  551.    (* FOLD: AddEntry *)
  552.    PROCEDURE AddEntry (VAR List : StringList; String : ARRAY OF CHAR) : BOOLEAN;
  553.  
  554.    VAR CurrentPtr, NewPtr, LastPtr : StringEntryPtr;
  555.  
  556.    BEGIN
  557.       Allocate (NewPtr, SIZE (NewPtr^));
  558.       IF NewPtr = NIL THEN
  559.          RETURN FALSE;
  560.       END; (* IF *)
  561.       Allocate (NewPtr^.string, List.maxLength + 1);
  562.       IF NewPtr^.string = NIL THEN
  563.          Deallocate (NewPtr);
  564.          RETURN FALSE;
  565.       END; (* IF *)
  566.       Copy (NewPtr^.string^, String);
  567.       IF (noSort IN DI.flags) OR (List.firstEntry = NIL) THEN
  568.          NewPtr^.nextEntry := List.firstEntry;
  569.          List.firstEntry   := NewPtr;
  570.       ELSE
  571.          LastPtr    := NIL;
  572.          CurrentPtr := List.firstEntry;
  573.          WHILE (Compare (CurrentPtr^.string^, String) < 0) AND
  574.                (CurrentPtr # NIL) DO
  575.             LastPtr    := CurrentPtr;
  576.             CurrentPtr := LastPtr^.nextEntry;
  577.          END; (* WHILE *)
  578.          NewPtr^.nextEntry := CurrentPtr;
  579.          IF LastPtr = NIL THEN
  580.             List.firstEntry := NewPtr;
  581.          ELSE
  582.             LastPtr^.nextEntry := NewPtr;
  583.          END; (* IF *)
  584.       END; (* IF *)
  585.       INC (List.numEntries);
  586.       RETURN TRUE;
  587.    END AddEntry;
  588.    (* ENDFD *)
  589.    (* FOLD: ConnectToDir *)
  590.    PROCEDURE ConnectToDir (VAR Dir : ARRAY OF CHAR; Sub : ARRAY OF CHAR);
  591.  
  592.    VAR Last : CARDINAL;
  593.  
  594.    BEGIN
  595.       Last := Length (Dir)-1;
  596.       IF (Dir[Last] # ':') AND (Dir[Last] # '/') THEN
  597.          Concat (Dir, "/");
  598.       END; (* IF *)
  599.       Concat (Dir, Sub);
  600.    END ConnectToDir;
  601.    (* ENDFD *)
  602.    (* FOLD: ConnectAll *)
  603.    PROCEDURE ConnectAll;
  604.  
  605.    BEGIN
  606.       IF DI.file[0] = 0C THEN
  607.          DI.path[0] := 0C;
  608.          RETURN;
  609.       END; (* IF *)
  610.       IF DI.dir[0] # 0C THEN
  611.          Copy (DI.path, DI.dir);
  612.          ConnectToDir (DI.path, DI.file);
  613.       ELSE
  614.          Copy (DI.path, DI.file);
  615.       END; (* IF *)
  616.       IF (watchSuffix IN DI.flags) AND (DI.suffix[0] # 0C) THEN
  617.          Concat (DI.path, ".");
  618.          Concat (DI.path, DI.suffix);
  619.       END; (* IF *)
  620.    END ConnectAll;
  621.    (* ENDFD *)
  622.    (* FOLD: MatchSuffix *)
  623.    PROCEDURE MatchSuffix (File : ARRAY OF CHAR; Suffix : ARRAY OF CHAR) : BOOLEAN;
  624.  
  625.    VAR DotPos : INTEGER;
  626.  
  627.    BEGIN
  628.       IF Suffix[0] = 0C THEN RETURN TRUE; END;
  629.       DotPos := LastPos (File, Length (File), '.');
  630.       IF DotPos = noOccur THEN RETURN FALSE; END;
  631.       IF Strings.Compare (File, DotPos+1, Length (Suffix)+1, Suffix, FALSE) = 0 THEN
  632.          RETURN TRUE;
  633.       ELSE
  634.          RETURN FALSE;
  635.       END; (* IF *)
  636.    END MatchSuffix;
  637.    (* ENDFD *)
  638.    (* FOLD: CutSuffix *)
  639.    PROCEDURE CutSuffix (VAR File : ARRAY OF CHAR);
  640.  
  641.    VAR DotPos : INTEGER;
  642.  
  643.    BEGIN
  644.       DotPos := LastPos (File, Length (File), '.');
  645.       IF DotPos # noOccur THEN
  646.          File[DotPos] := 0C;
  647.       END; (* IF *)
  648.    END CutSuffix;
  649.    (* ENDFD *)
  650.    (* FOLD: GetPathFromLock *)
  651.    PROCEDURE GetPathFromLock (VAR Path : ARRAY OF CHAR; ThisLockPtr : FileLockPtr);
  652.  
  653.    (* von irgendeiner PD-Disk aus 'C' in Modula-II üersetzt (Autor ???) *)
  654.  
  655.    VAR CurDirPtr : FileLockPtr;
  656.        OldDirPtr : FileLockPtr;
  657.        FIBPtr    : FileInfoBlockPtr;
  658.        VolumeLen : CARDINAL;
  659.  
  660.    BEGIN
  661.       Copy (Path, "");
  662.       CurDirPtr := DupLock (ThisLockPtr);
  663.       IF CurDirPtr = NIL THEN RETURN; END;
  664.       Allocate (FIBPtr, SIZE (FIBPtr^));
  665.       IF FIBPtr # NIL THEN
  666.          Forbid;
  667.          BSTRCopy (Path, CurDirPtr^.volume^.name);
  668.          Permit;
  669.          Concat (Path, ":");
  670.          VolumeLen := Length (Path);
  671.          WHILE CurDirPtr # NIL DO
  672.             IF NOT (Examine (CurDirPtr, FIBPtr)) THEN
  673.                Copy (Path, "");
  674.                UnLock (CurDirPtr);
  675.                CurDirPtr := NIL;
  676.             ELSE
  677.                OldDirPtr := CurDirPtr;
  678.                CurDirPtr := ParentDir (OldDirPtr);
  679.                UnLock (OldDirPtr);
  680.                IF CurDirPtr # NIL THEN
  681.                   IF Length (Path) # VolumeLen THEN
  682.                      Strings.Insert (Path, VolumeLen, "/");
  683.                   END; (* IF *)
  684.                   Strings.Insert (Path, VolumeLen, FIBPtr^.fileName);
  685.                END; (* IF *)
  686.             END; (* IF *)
  687.          END; (* WHILE *)
  688.          Deallocate (FIBPtr);
  689.       END; (* IF *)
  690.    END GetPathFromLock;
  691.    (* ENDFD *)
  692.    (* FOLD: UpdateGadgets *)
  693.    PROCEDURE UpdateGadgets;
  694.  
  695.       (* FOLD: OnlyRefresh *)
  696.       PROCEDURE OnlyRefresh (WhichGadget : Gadget);
  697.  
  698.       BEGIN
  699.          RefreshGList (ADR (WhichGadget), DiskyWindowPtr, NIL, 0);
  700.       END OnlyRefresh;
  701.       (* ENDFD *)
  702.  
  703.    VAR Body, Pot : CARDINAL;
  704.  
  705.    BEGIN
  706.       WITH GadgetsPtr^ DO
  707.          IF NOT (selected IN Str[1].flags) THEN
  708.             WITH StrInfo[1] DO
  709.                numChars  := Length (DI.dir);
  710.                IF numChars >= dispCount THEN
  711.                   dispPos   := numChars - dispCount + 1;
  712.                ELSE
  713.                   dispPos := 0;
  714.                END; (* IF *)
  715.                bufferPos := numChars;
  716.             END; (* WITH *)
  717.             OnlyRefresh (Str[1]);
  718.          END; (* IF *)
  719.          IF NOT (selected IN Str[2].flags) THEN
  720.             WITH StrInfo[2] DO
  721.                numChars  := Length (DI.file);
  722.                bufferPos := 0;
  723.                dispPos   := 0;
  724.             END; (* WITH *)
  725.             OnlyRefresh (Str[2]);
  726.          END; (* IF *)
  727.  
  728.          IF (DirList.numEntries + FileList.numEntries > 10) THEN
  729.             Body := (maxBody DIV (DirList.numEntries + FileList.numEntries))*10;
  730.             Pot  := MyPropInfo.vertPot;
  731.          ELSE
  732.             Body := maxBody;
  733.             Pot  := 0;
  734.          END; (* IF *)
  735.          NewModifyProp (ADR (Prop), DiskyWindowPtr, NIL,
  736.                         PropInfoFlagSet {freeVert, autoKnob}, 0, Pot, 0, Body, 1);
  737.       END; (* WITH *)
  738.    END UpdateGadgets;
  739.    (* ENDFD *)
  740.    (* FOLD: CloseDown *)
  741.    PROCEDURE CloseDown;
  742.  
  743.    VAR border : [1..2];
  744.  
  745.    BEGIN
  746.       IF (ownFont IN DI.flags) THEN
  747.          IF FontPtr # NIL THEN
  748.             CloseFont (FontPtr);
  749.             FontPtr := NIL;
  750.          END; (* IF *)
  751.       END; (* IF *)
  752.       IF CurrentLockPtr # NIL THEN
  753.          UnLock (CurrentLockPtr);
  754.          CurrentLockPtr := NIL;
  755.       END; (* IF *)
  756.       FreeList (DirList);
  757.       FreeList (FileList);
  758.       FreeBorder (GadgetsPtr^.BoolBorder);
  759.       FOR border := 1 TO 2 DO
  760.          FreeBorder (GadgetsPtr^.StrBorder[border]);
  761.          FreeBorder (GadgetsPtr^.SufBorder[border]);
  762.       END; (* FOR *)
  763.       FreeBorder (GadgetsPtr^.HyperBorder);
  764.       IF DiskyWindowPtr # NIL THEN
  765.          CloseWindow (DiskyWindowPtr);
  766.       END; (* IF *)
  767.       IF MyFIBPtr # NIL THEN
  768.          Deallocate (MyFIBPtr);
  769.       END; (* IF *)
  770.       IF GadgetsPtr # NIL THEN
  771.          Deallocate (GadgetsPtr);
  772.       END; (* IF *)
  773.    END CloseDown;
  774.    (* ENDFD *)
  775.    (* FOLD: GetGadID *)
  776.    PROCEDURE GetGadID (VAR ID : CARDINAL) : BOOLEAN;
  777.  
  778.    VAR MyMessagePtr   : IntuiMessagePtr;
  779.        actGadgetPtr   : GadgetPtr;
  780.        Class          : IDCMPFlagSet;
  781.  
  782.    BEGIN
  783.       IF Mode = ready THEN
  784.          WaitPort (DiskyWindowPtr^.userPort);
  785.       END; (* IF *)
  786.       MyMessagePtr := GetMsg (DiskyWindowPtr^.userPort);
  787.       IF MyMessagePtr # NIL THEN
  788.          WITH MyMessagePtr^ DO
  789.             Class := class;
  790.             Sec   := seconds;
  791.             Mic   := micros;
  792.          END; (* WITH *)
  793.          IF (gadgetUp IN Class) THEN
  794.             actGadgetPtr := MyMessagePtr^.iAddress;
  795.             ID := actGadgetPtr^.gadgetID;
  796.             ReplyMsg (MyMessagePtr);
  797.             RETURN TRUE;
  798.          ELSIF (mouseMove IN Class) THEN
  799.             ID := GadgetsPtr^.Prop.gadgetID;
  800.             ReplyMsg (MyMessagePtr);
  801.             RETURN TRUE;
  802.          ELSE
  803.             ReplyMsg (MyMessagePtr);
  804.             RETURN FALSE;
  805.          END; (* IF *)
  806.       ELSE
  807.          RETURN FALSE;
  808.       END; (* IF *)
  809.    END GetGadID;
  810.    (* ENDFD *)
  811.    (* FOLD: RefreshFiles *)
  812.    PROCEDURE RefreshFiles (sure : BOOLEAN);
  813.  
  814.    VAR TopOfDisplay : CARDINAL;
  815.        HelpTop      : LONGCARD;
  816.        DirsShown    : CARDINAL;
  817.  
  818.       (* FOLD: GetEntry *)
  819.       PROCEDURE GetEntry (List : StringList; VAR String : ARRAY OF CHAR;
  820.                           Number : CARDINAL);
  821.  
  822.       VAR CurrentPtr : StringEntryPtr;
  823.           count      : CARDINAL;
  824.  
  825.       BEGIN
  826.          count := 1;
  827.          IF List.numEntries < Number THEN
  828.             Copy (String, "");
  829.             RETURN;
  830.          END; (* IF *)
  831.          CurrentPtr := List.firstEntry;
  832.          WHILE (count < Number) DO
  833.             CurrentPtr := CurrentPtr^.nextEntry;
  834.             INC (count);
  835.          END; (* WHILE *)
  836.          Copy (String, CurrentPtr^.string^);
  837.       END GetEntry;
  838.       (* ENDFD *)
  839.       (* FOLD: MakeGadITxt *)
  840.       PROCEDURE MakeGadITxt;
  841.  
  842.       VAR Len  : CARDINAL;
  843.           Fill : CARDINAL;
  844.  
  845.       BEGIN
  846.          WITH GadgetsPtr^ DO
  847.             Copy (FileTxt[FileNum], Files[FileNum]);
  848.             Len := Length (FileTxt[FileNum]);
  849.             FOR Fill := Len TO MaxFL-1 DO
  850.                FileTxt[FileNum][Fill] := ' ';
  851.             END; (* FOR *)
  852.             FileTxt[FileNum][MaxFL] := 0C;
  853.             FileITxt[FileNum].iText := ADR (FileTxt[FileNum]);
  854.             IF FMode[FileNum] = dir THEN
  855.                IF NOT (ownColors IN DI.flags) THEN
  856.                   FileITxt[FileNum].frontPen := StdDPen;
  857.                ELSE
  858.                   FileITxt[FileNum].frontPen := DI.dirPen;
  859.                END; (* IF *)
  860.             ELSIF FMode[FileNum] = file THEN
  861.                IF NOT (ownColors IN DI.flags) THEN
  862.                   FileITxt[FileNum].frontPen := StdFPen;
  863.                ELSE
  864.                   FileITxt[FileNum].frontPen := DI.filePen;
  865.                END; (* IF *)
  866.             END; (* IF *)
  867.          END; (* WITH *)
  868.       END MakeGadITxt;
  869.       (* ENDFD *)
  870.  
  871.    BEGIN
  872.       IF (DirList.numEntries + FileList.numEntries > 10) THEN
  873.          HelpTop := GadgetsPtr^.MyPropInfo.vertPot;
  874.          HelpTop := (HelpTop * (DirList.numEntries + FileList.numEntries - 10)) /
  875.                     maxPot;
  876.          TopOfDisplay := HelpTop;
  877.       ELSE
  878.          TopOfDisplay := 0;
  879.       END; (* IF *)
  880.       IF (OldTop # TopOfDisplay) OR (sure = TRUE) THEN
  881.          OldTop := TopOfDisplay;
  882.          IF TopOfDisplay < DirList.numEntries THEN
  883.             DirsShown := TopOfDisplay;
  884.          ELSE
  885.             DirsShown := DirList.numEntries;
  886.          END; (* IF *)
  887.          FOR FileNum := 1 TO 10 DO
  888.             IF FileNum + TopOfDisplay <= DirList.numEntries THEN
  889.                GetEntry (DirList, Files[FileNum], FileNum + TopOfDisplay);
  890.                FMode[FileNum] := dir;
  891.                INC (DirsShown);
  892.             ELSIF FileNum+TopOfDisplay-DirsShown <= FileList.numEntries THEN
  893.                GetEntry (FileList, Files[FileNum], FileNum + TopOfDisplay -
  894.                                                    DirsShown);
  895.                FMode[FileNum] := file;
  896.             ELSE
  897.                Copy (Files[FileNum], "");
  898.                FMode[FileNum] := empty;
  899.             END; (* IF *)
  900.             MakeGadITxt;
  901.          END; (* FOR *)
  902.          RefreshGList (ADR (GadgetsPtr^.File[1]), DiskyWindowPtr, NIL, 10);
  903.       END; (* IF *)
  904.    END RefreshFiles;
  905.    (* ENDFD *)
  906.    (* FOLD: PrepareRead *)
  907.    PROCEDURE PrepareRead;
  908.  
  909.    BEGIN
  910.       IF CurrentLockPtr = NIL THEN
  911.          DisplayBeep (NIL);
  912.          Mode := ready;
  913.       ELSE
  914.          FreeList (DirList);
  915.          FreeList (FileList);
  916.          FOR FileNum := 1 TO 10 DO
  917.             FMode[FileNum] := empty;
  918.          END; (* FOR *)
  919.          GetPathFromLock (DI.dir, CurrentLockPtr);
  920.          ConnectAll;
  921.          UpdateGadgets;
  922.          RefreshFiles (TRUE);
  923.          IF NOT Examine (CurrentLockPtr, MyFIBPtr) THEN
  924.             DisplayBeep (NIL);
  925.             Mode := ready;
  926.          ELSE
  927.             IF MyFIBPtr^.dirEntryType <= 0 THEN
  928.                DisplayBeep (NIL);
  929.                Mode := ready;
  930.             ELSE
  931.                IF ExNext (CurrentLockPtr, MyFIBPtr) THEN END;
  932.                Mode := read;
  933.             END; (* IF *)
  934.          END; (* IF *)
  935.       END; (* IF *)
  936.    END PrepareRead;
  937.    (* ENDFD *)
  938.    (* FOLD: ReadDir *)
  939.    PROCEDURE ReadDir;
  940.  
  941.    VAR GetFile      : BOOLEAN;
  942.        FileStore    : ARRAY [0..MaxFL] OF CHAR;
  943.  
  944.    BEGIN
  945.       IF (IoErr() = noMoreEntries) THEN
  946.          Mode := ready;
  947.          UpdateGadgets;
  948.          RefreshFiles (TRUE);
  949.       ELSE
  950.          GetFile := TRUE;
  951.          Copy (FileStore, MyFIBPtr^.fileName);
  952.          IF (MyFIBPtr^.dirEntryType > 0) AND NOT (onlyFiles IN DI.flags) THEN
  953.             IF (dirExt IN DI.flags) THEN
  954.                Concat (FileStore, " (dir)");
  955.             END; (* IF *)
  956.             IF (AddEntry (DirList, FileStore) = FALSE) THEN
  957.                DisplayBeep (NIL);
  958.             END; (* IF *)
  959.          ELSIF MyFIBPtr^.dirEntryType < 0 THEN
  960.             IF NOT (displayInfo IN DI.flags) THEN
  961.                IF (MatchSuffix (FileStore, "info") = TRUE) THEN
  962.                   GetFile := FALSE;
  963.                END; (* IF *)
  964.             END; (* IF *)
  965.             IF (watchSuffix IN DI.flags) THEN
  966.                IF (MatchSuffix (FileStore, DI.suffix) = FALSE) THEN
  967.                   GetFile := FALSE;
  968.                END; (* IF *)
  969.             END; (* IF *)
  970.             IF (callFileTest IN DI.flags) THEN
  971.                IF DI.fileTestProc # NIL THEN
  972.                   GetFile := DI.fileTestProc (FileStore);
  973.                END; (* IF *)
  974.             END; (* IF *)
  975.             IF GetFile = TRUE THEN
  976.                IF (DI.suffix[0] # 0C) AND (watchSuffix IN DI.flags) THEN
  977.                   CutSuffix (FileStore);
  978.                END; (* IF *)
  979.                IF (AddEntry (FileList, FileStore) = FALSE) THEN
  980.                   DisplayBeep (NIL);
  981.                END; (* IF *)
  982.             END; (* IF *)
  983.          END; (* IF *)
  984.       END; (* IF *)
  985.       IF ExNext (CurrentLockPtr, MyFIBPtr) THEN END;
  986.    END ReadDir;
  987.    (* ENDFD *)
  988.    (* FOLD: ScanPath *)
  989.    PROCEDURE ScanPath;
  990.  
  991.    VAR HelpLockPtr : FileLockPtr;
  992.        PathStore   : ARRAY [0..200] OF CHAR;
  993.        FIBPtr      : FileInfoBlockPtr;
  994.  
  995.       (* FOLD: GetSuffix *)
  996.       PROCEDURE GetSuffix;
  997.  
  998.       VAR DotPos : INTEGER;
  999.           SufPtr : StringPtr;
  1000.  
  1001.       BEGIN
  1002.          DotPos := LastPos (PathStore, Length (PathStore), '.');
  1003.          IF DotPos # noOccur THEN
  1004.             SufPtr := ADR (PathStore[DotPos+1]);
  1005.             Copy (DI.suffix, SufPtr^);
  1006.             PathStore[DotPos] := 0C;
  1007.          END; (* IF *)
  1008.       END GetSuffix;
  1009.       (* ENDFD *)
  1010.       (* FOLD: GetFile *)
  1011.       PROCEDURE GetFile;
  1012.  
  1013.       VAR DivPos  : INTEGER;
  1014.           FilePtr : StringPtr;
  1015.  
  1016.       BEGIN
  1017.          DivPos := LastPos (PathStore, Length (PathStore), '/');
  1018.          IF DivPos = noOccur THEN
  1019.             DivPos := LastPos (PathStore, Length (PathStore), ':');
  1020.             IF DivPos = noOccur THEN
  1021.                Copy (DI.file, PathStore);
  1022.                RETURN;
  1023.             END; (* IF *)
  1024.          END; (* IF *)
  1025.          FilePtr := ADR (PathStore[DivPos+1]);
  1026.          Copy (DI.file, FilePtr^);
  1027.          PathStore[DivPos] := 0C;
  1028.       END GetFile;
  1029.       (* ENDFD *)
  1030.  
  1031.    BEGIN
  1032.       Allocate (FIBPtr, SIZE (FIBPtr^));
  1033.       IF FIBPtr # NIL THEN
  1034.          HelpLockPtr := Lock (ADR (DI.path), accessRead);
  1035.          IF HelpLockPtr # NIL THEN
  1036.             GetPathFromLock (PathStore, HelpLockPtr);
  1037.             Copy (DI.path, PathStore);
  1038.             IF Examine (HelpLockPtr, FIBPtr) THEN
  1039.                IF FIBPtr^.dirEntryType < 0 THEN
  1040.                   IF (watchSuffix IN DI.flags) THEN
  1041.                      GetSuffix;
  1042.                   END; (* IF *)
  1043.                   GetFile;
  1044.                END; (* IF *)
  1045.                Copy (DI.dir, PathStore);
  1046.                UnLock (HelpLockPtr);
  1047.             END; (* IF *)
  1048.          END; (* IF *)
  1049.       END; (* IF *)
  1050.       Deallocate (FIBPtr);
  1051.    END ScanPath;
  1052.    (* ENDFD *)
  1053.  
  1054. BEGIN
  1055.    IF (startPath IN DI.flags) THEN
  1056.       ScanPath;
  1057.    END; (* IF *)
  1058.    FontPtr := NIL;
  1059.    Allocate (MyFIBPtr, SIZE (MyFIBPtr^));
  1060.    IF MyFIBPtr = NIL THEN CloseDown; RETURN ErrNoMem; END;
  1061.    Allocate (GadgetsPtr, SIZE (GadgetsPtr^));
  1062.    IF GadgetsPtr = NIL THEN CloseDown; RETURN ErrNoMem; END;
  1063.    IF BuildRequester() = FALSE THEN CloseDown; RETURN ErrNoReq; END;
  1064.    InitList (DirList, MaxFL);
  1065.    InitList (FileList, MaxFL);
  1066.    Mode := begin;
  1067.    CurrentLockPtr := Lock (ADR (DI.dir), accessRead);
  1068.    IF CurrentLockPtr = NIL THEN
  1069.       DisplayBeep (NIL);
  1070.       CurrentLockPtr := Lock (NIL, accessRead);
  1071.       IF CurrentLockPtr = NIL THEN
  1072.          DisplayBeep (NIL);
  1073.          Mode := ready;
  1074.       END; (* IF *)
  1075.    END; (* IF *)
  1076.    LOOP
  1077.       IF GetGadID (ID) = TRUE THEN
  1078.          CASE ID OF
  1079.          |  MinFileID..MaxFileID :
  1080.             IF FMode[ID] = dir THEN
  1081.                IF (CurrentLockPtr # NIL) THEN
  1082.                   UnLock (CurrentLockPtr);
  1083.                END; (* IF *)
  1084.                IF (dirExt IN DI.flags) THEN
  1085.                   len := Length (Files[ID]);
  1086.                   Files[ID][len-6] := 0C;
  1087.                END; (* IF *)
  1088.                ConnectToDir (DI.dir, Files[ID]);
  1089.                CurrentLockPtr := Lock (ADR (DI.dir), accessRead);
  1090.                Mode := begin;
  1091.             ELSIF FMode[ID] = file THEN
  1092.                IF (Compare (DI.file, Files[ID]) = 0) THEN
  1093.                   (* Doppelklick *)
  1094.                   IF DoubleClick (lastSec, lastMic, Sec, Mic) THEN
  1095.                      IF (fileExists IN DI.flags) THEN
  1096.                         IF FileExists (DI.path) = TRUE THEN
  1097.                            CloseDown;
  1098.                            RETURN DiskyOK;
  1099.                         ELSE
  1100.                            DisplayBeep (NIL);
  1101.                         END; (* IF *)
  1102.                      ELSE
  1103.                         CloseDown;
  1104.                         RETURN DiskyOK;
  1105.                      END; (* IF *)
  1106.                   END; (* IF *)
  1107.                ELSE
  1108.                   Copy (DI.file, Files[ID]);
  1109.                   ConnectAll;
  1110.                   UpdateGadgets;
  1111.                END; (* IF *)
  1112.             END; (* IF *)
  1113.             lastSec := Sec; lastMic := Mic;
  1114.          |  PropID :
  1115.             RefreshFiles (FALSE);
  1116.          |  MinPathID..MaxPathID :
  1117.             LOOP
  1118.                BackupLockPtr := CurrentLockPtr;
  1119.                CurrentLockPtr := ParentDir (CurrentLockPtr);
  1120.                IF CurrentLockPtr = NIL THEN
  1121.                   IF ID = ParentID THEN
  1122.                      DisplayBeep (NIL);
  1123.                   END; (* IF *)
  1124.                   CurrentLockPtr := BackupLockPtr;
  1125.                   EXIT;
  1126.                ELSE
  1127.                   UnLock (BackupLockPtr);
  1128.                   Mode := begin;
  1129.                END; (* IF *)
  1130.                IF ID = ParentID THEN
  1131.                   EXIT;
  1132.                END; (* IF *)
  1133.             END; (* LOOP *)
  1134.          |  MinDevID..MaxDevID :
  1135.             IF CurrentLockPtr # NIL THEN
  1136.                UnLock (CurrentLockPtr);
  1137.             END; (* IF *)
  1138.             CurrentLockPtr := Lock (ADR (GadgetsPtr^.DevTxt[ID - MinDevID + 1]),
  1139.                                     accessRead);
  1140.             Mode := begin;
  1141.          |  MinStrID..MaxStrID :
  1142.             IF ID = DirID THEN
  1143.                IF CurrentLockPtr # NIL THEN
  1144.                   UnLock (CurrentLockPtr);
  1145.                END; (* IF *)
  1146.                CurrentLockPtr := Lock (GadgetsPtr^.StrInfo[1].buffer, accessRead);
  1147.                Mode := begin;
  1148.             ELSIF ID = SuffixID THEN
  1149.                Mode := begin;
  1150.             END; (* IF *)
  1151.             ConnectAll;
  1152.          |  MinEndID..MaxEndID :
  1153.             ConnectAll;
  1154.             IF ID = OKID THEN
  1155.                IF (fileExists IN DI.flags) THEN
  1156.                   IF FileExists (DI.path) = TRUE THEN
  1157.                      CloseDown;
  1158.                      RETURN DiskyOK;
  1159.                   ELSE
  1160.                      DisplayBeep (NIL);
  1161.                   END; (* IF *)
  1162.                ELSE
  1163.                   CloseDown;
  1164.                   RETURN DiskyOK;
  1165.                END; (* IF *)
  1166.             ELSIF ID = CancelID THEN
  1167.                CloseDown;
  1168.                RETURN DiskyCancel;
  1169.             END; (* IF *)
  1170.          END; (* CASE *)
  1171.       END; (* IF *)
  1172.       IF Mode = begin THEN
  1173.          PrepareRead;
  1174.       ELSIF Mode = read THEN
  1175.          ReadDir;
  1176.       END; (* IF *)
  1177.    END; (* LOOP *)
  1178. END Disky;
  1179. (* ENDFD *)
  1180.  
  1181. BEGIN
  1182.    AllocProc   := AllocMem;
  1183.    DeallocProc := Deallocate;
  1184. END FileRequest.
  1185.